home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: PD Unicornics / PD Unicornics-Graphs 01 (19xx)(Gartelmann, Peter)(DE)(PD)[h added AmigaBasic].zip / PD Unicornics-Graphs 01 (19xx)(Gartelmann, Peter)(DE)(PD)[h added AmigaBasic].adf / fractalmountain (.txt) < prev    next >
AmigaBASIC Source Code  |  1988-12-31  |  4KB  |  198 lines
  1. CLEAR 32767
  2. DEFSNG a-z
  3. DIM Lv(64,64)
  4. DIM cmap$(31)
  5. PRINT"    Copyright 1987"
  6. PRINT"Compute Publications, Inc."
  7. PRINT"   All Rights Reserved.":PRINT
  8. RANDOMIZE
  9. PRINT"Enter maximum variation (0-2) (1 is nice) ";:INPUT max
  10. PRINT"Enter a filename to save picture under."
  11. INPUT "(Saving at end is optional.)   ";fiL$
  12. FOR a = 1 TO 10
  13. PRINT RND
  14. NEXT
  15. SCREEN 2,320,200,5,1
  16. WINDOW 3,"Mountain",(0,0) - (311,186),28,2
  17. FOR a = 0 TO 15
  18. PALETTE a,a/15,a/25,a/50
  19. PALETTE a+16,a/15,a/15,a/15
  20. a$ = CHR$(a*17)
  21. cmap$(a) = a$+CHR$(a*10.2)+CHR$(a*5.1)
  22. cmap$(a+16) = a$+a$+a$
  23. NEXT
  24. PALETTE 16,0,0.25,0.5
  25. cmap$(16) = CHR$(0)+CHR$(64)+CHR$(128)
  26. COLOR 15
  27. maxLv = 0
  28. MakeMount:
  29. FOR iter = 6 TO 1 STEP -1
  30. sk = 2 ^ iter
  31. hL = sk/2
  32. PRINT"Doing Iteration";iter
  33. Dotops:
  34. PRINT"Tops & Bottoms  ";
  35. FOR y = 0 TO 64 STEP sk
  36. FOR x = hL TO 64 STEP sk
  37. ran = (RND-0.5)*max*sk
  38. oLd = (Lv(x-hL,y) + Lv(x+hL,y))/2
  39. Lv(x,y) = oLd + ran
  40. NEXT x
  41. NEXT y
  42. Dobottoms:
  43. PRINT "Sides  ";
  44. FOR x = 0 TO 64 STEP sk
  45. FOR y = hL TO 64 STEP sk
  46. ran = (RND-0.5)*max*sk
  47. oLd = (Lv(x,y-hL) + Lv(x,y+hL))/2
  48. Lv(x,y) = oLd + ran
  49. NEXT y
  50. NEXT x
  51. Docentres:
  52. PRINT "Centers  "
  53. FOR x = hL TO 64 STEP sk
  54. FOR y = hL TO 64 STEP sk
  55. ran = (RND-0.5)*max*sk
  56. oLd1 = (Lv(x+hL,y-hL) + Lv(x-hL,y+hL))/2
  57. oLd2 = (Lv(x-hL,y-hL) + Lv(x+hL,y+hL))/2
  58. oLd = (oLd1 + oLd2)/2
  59. Lv(x,y) = oLd + ran
  60. IF Lv(x,y) > maxLv THEN maxLv = Lv(x,y)
  61. NEXT y
  62. NEXT x
  63. NEXT iter
  64. snowLine = maxLv - maxLv/4
  65. drawmount:
  66. CLS
  67. xm = 4
  68. ym = 1
  69. xshift = 0.5
  70. yp = 70
  71. FOR x = 0 TO 64
  72. IF Lv(x,0) < 0 THEN Lv(x,0) = 0
  73. NEXT x
  74. FOR y = 0 TO 63
  75. IF Lv(0,y) < 0 THEN Lv(0,y) = 0
  76. FOR x = 0 TO 63
  77. IF Lv(x+1,y+1) < 0 THEN Lv(x+1,y+1) = 0
  78. Lv = Lv(x,y) + Lv(x+1,y) + Lv(x,y+1)
  79. Lv = (Lv + Lv(x+1,y+1))/4
  80. a=x:b=y
  81. rx1 = xm * a + xshift * b
  82. ry1 = ym * b + yp - Lv(a,b)
  83. GOSUB getshade:
  84. shade1 = shade
  85. a = x + 1
  86. rx2 = xm * a + xshift * b
  87. ry2 = ym * b + yp - Lv(a,b)
  88. GOSUB getshade:
  89. shade2 = shade
  90. a = x:b = y + 1
  91. rx3 = xm * a + xshift * b
  92. ry3 = ym * b +yp - Lv(a,b)
  93. GOSUB getshade:
  94. shade3 = shade
  95. a = x + 1
  96. rx4 = xm * a + xshift * b
  97. ry4 = ym * b + yp - Lv(a,b)
  98. GOSUB getshade:
  99. shade4 = shade
  100. a = x + 0.5:b = y + 0.5
  101. rx = xm * a + xshift * b
  102. ry = ym * b + yp
  103. a=x:b=y
  104. ry = ry - Lv
  105. AREA (rx,ry)
  106. AREA (rx1,ry1)
  107. AREA (rx2,ry2)
  108. COLOR shade1
  109. AREAFILL
  110. AREA (rx,ry)
  111. AREA (rx4,ry4)
  112. COLOR shade2
  113. AREAFILL
  114. AREA (rx,ry)
  115. AREA (rx1,ry1)
  116. AREA (rx3,ry3)
  117. COLOR shade3
  118. AREAFILL
  119. AREA (rx,ry)
  120. AREA (rx3,ry3)
  121. AREA (rx4,ry4)
  122. COLOR shade4
  123. AREAFILL
  124. NEXT x
  125. NEXT y
  126. ender:
  127. a$ = INKEY$
  128. IF a$ = "s" THEN GOTO savepic
  129. IF a$ <> " " THEN GOTO ender
  130. end2:
  131. WINDOW CLOSE 3
  132. SCREEN CLOSE 2
  133. WINDOW OUTPUT 1
  134. END
  135. getshade:
  136. c = x + 1 - (b-y)
  137. d = y + (a-x)
  138. xc = x + 0.5
  139. yc = y + 0.5
  140. xrun1 = xc - a
  141. xrun2 = xc - c
  142. yrun1 = yc - b
  143. yrun2 = yc - d
  144. rise1 = Lv - Lv(a,b)
  145. rise2 = Lv - Lv(c,d)
  146. yrise = ABS(rise1*xrun2 - rise2*xrun1)
  147. yrun = ABS(yrun1*xrun2 - xrun1*yrun2)
  148. IF yrun = yrise THEN yrun = 1:yrise = 1
  149. xrise = ABS(rise1*yrun2 - rise2*yrun1)
  150. xrun = ABS(xrun1*yrun2 - yrun1*xrun2)
  151. IF xrun = xrise THEN xrun = 1:xrise = 1
  152. xrise = xrise / 2
  153. yrise = yrise / 2
  154. xshade = 1-ABS(xrise / (xrun + xrise))
  155. yshade = 1-ABS(yrise / (yrun + yrise))
  156. shade = 14*xshade*yshade+1
  157. IF Lv > snowLine THEN shade = shade + 16
  158. IF Lv <= 0 THEN shade = 16
  159. RETURN
  160. savepic:
  161. rastport& = WINDOW(8)
  162. bitmap& = PEEKL(rastport&+4)
  163. topLine = 60 - INT(maxLv)
  164. IF topLine < 0 THEN topLine = 0
  165. topadd = topLine * 40
  166. FOR a = 0 TO 4
  167. pLane&(a) = PEEKL(bitmap& + 8 + a*4)+topadd
  168. NEXT
  169. bottomLine = 144
  170. Lines = bottomLine - topLine
  171. OPEN fiL$ FOR OUTPUT AS 1
  172. a$ = MKL$(Lines * 40 * 5 + 144)
  173. PRINT#1,"FORM";a$;"ILBMBMHD";MKL$(20);
  174. PRINT#1,MKI$(320);MKI$(Lines);MKL$(0);
  175. PRINT#1,CHR$(5);MKI$(0);CHR$(0);
  176. PRINT#1,MKI$(0);CHR$(10);CHR$(11);
  177. PRINT#1,MKI$(320);MKI$(200);
  178. PRINT#1,"CMAP";MKL$(96);
  179. FOR a = 0 TO 31
  180. PRINT#1,cmap$(a);
  181. NEXT
  182. PRINT#1,"BODY";MKL$(Lines * 40 * 5);
  183. FOR a = 1 TO Lines
  184. FOR p = 0 TO 4
  185. FOR b = 0 TO 39 STEP 4
  186. PRINT#1,MKL$(PEEKL(pLane&(p) + b));
  187. NEXT b
  188. POKEL pLane&(p), -1
  189. pLane&(p) = pLane&(p) + 40
  190. NEXT p
  191. NEXT a
  192. CLOSE
  193. GOTO end2
  194.  
  195.  
  196.  
  197.  
  198.